home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO064.dsk / ADD.PRT.bas < prev    next >
BASIC Source File  |  2012-02-16  |  13KB  |  185 lines
  1. 600  CALL 39169,X$: IF X$ = ""  THEN SX$ = "": RETURN 
  2. 615 SX$ = "": IF  LEN(X$) >30  THEN  FOR J = 1 TO 30:SX$ = SX$ + CHR$( ASC( MID$ (X$,J,1))): NEXT :X$ = SX$:SX$ = "": VTAB 23: PRINT "NOTE - ENTRY HAS BEEN TRUNCATED";: HTAB 1
  3. 630  FOR K = 1 TO  LEN(X$): IF  ASC( MID$ (X$,K,1)) >96  AND  ASC( MID$ (X$,K,1)) <123  THEN SX$ = SX$ + CHR$( ASC( MID$ (X$,K,1)) -32): NEXT K: RETURN 
  4. 640 SX$ = SX$ + MID$ (X$,K,1): NEXT K: RETURN 
  5. 700  HTAB 1: VTAB 7: PRINT "    (F) ";B$(Y);: CALL 64668: HTAB 1: VTAB 8: PRINT "    (L) ";A$(Y);: CALL 64668: HTAB 1: VTAB 9: PRINT "    (S) ";C$(Y);: CALL 64668: HTAB 1
  6. 730  VTAB 10: PRINT "    (C) ";CC$(Y);: CALL 64668: HTAB 1: VTAB 13: PRINT "______________________________________": RETURN 
  7. 900  HTAB 2: VTAB 23: PRINT " DO YOU WISH TO DELETE THIS DATA ? ";: GET Z$: PRINT Z$;: IF Z$ = "Y"  OR Z$ = "y"  THEN  TEXT : GOSUB 1000: GOSUB 18600: RETURN 
  8. 930  HOME : GOTO 7000
  9. 1000 A$(0) = "":SA$(0) = "":B$(0) = "":SB$(0) = "":C$(0) = "":CC$(0) = "":E$(0) = "": RETURN 
  10. 6000  GOTO 6200
  11. 6100  PRINT  CHR$(24): INVERSE :T = CV -VS: IF A >1  THEN  GOSUB 6160: RETURN 
  12. 6110  GOSUB 6170: RETURN 
  13. 6130  HTAB HT -3: VTAB CV: PRINT " ";:T = CV -VS: IF A >1  THEN  GOSUB 6160: RETURN 
  14. 6140  GOSUB 6170: RETURN 
  15. 6160  HTAB HT: VTAB VS +T: PRINT "(";T +1;")";" ";PM$(M,T +1);: NORMAL : CALL 64668: RETURN 
  16. 6170  HTAB HT: VTAB VS +T: PRINT "("; LEFT$(PM$(M,T +1),A);")";" ";PM$(M,T +1);: NORMAL : CALL 64668: RETURN 
  17. 6200  IF VS < >0  THEN  HTAB 1: VTAB 1: PRINT MS$(M): GOTO 6240
  18. 6220  HOME : PRINT MS$(M):VS =  INT(((18 -MN(M))/2) +6): VTAB VS -3: PRINT PM$(M,0)
  19. 6240 T = 0: FOR J = 1 TO MN(M): IF A >1  THEN  GOSUB 6160: GOTO 6290
  20. 6280  GOSUB 6170
  21. 6290 T = T +1: NEXT J
  22. 6320  IF G(M) >0  AND G(M) <25  THEN  VTAB G(M):CV = G(M): GOTO 6360
  23. 6350  VTAB VS:CV = VS
  24. 6360  GOSUB 6370: GOTO 6760
  25. 6370  HTAB HT -3:
  26. 6400  GOSUB 6100: WAIT  -16384,128:Z$ =  CHR$( PEEK( -16384) -128): POKE  -16368,0
  27. 6450  IF Z$ =  CHR$(27)  THEN CV = 27: RETURN 
  28. 6460  IF Z$ =  CHR$(13)  THEN  RETURN 
  29. 6480  IF Z$ =  CHR$(11)  THEN  GOSUB 6130:CV = CV -1: GOTO 6690
  30. 6490  IF Z$ =  CHR$(21)  THEN  GOSUB 6130:CV = CV -1: GOTO 6690
  31. 6500  IF Z$ =  CHR$(10)  THEN  GOSUB 6130:CV = CV +1: GOTO 6690
  32. 6510  IF Z$ =  CHR$(32)  THEN  GOSUB 6130:CV = CV +1: GOTO 6690
  33. 6520  IF Z$ =  CHR$(08)  THEN  GOSUB 6130:CV = CV +1: GOTO 6690
  34. 6540  GOSUB 6130:
  35. 6550 T = 0: FOR J = 1 TO MN(M): IF Z$ =  LEFT$(PM$(M,J),1)  THEN CV = VS +T: GOSUB 6100: FOR DQ = 1 TO 200: NEXT DQ: RETURN 
  36. 6580  IF Z$ =  CHR$( ASC( LEFT$(PM$(M,J),1)) +32)  THEN  GOTO 6600
  37. 6590  GOTO 6610
  38. 6600  IF  ASC(Z$) >96  AND  ASC(Z$) <123  THEN CV = VS +T: GOSUB 6100: FOR DQ = 1 TO 200: NEXT DQ: RETURN 
  39. 6610  IF A >1  AND  VAL(Z$) = J  THEN CV = VS +T: GOSUB 6100: FOR DQ = 1 TO 200: NEXT DQ: RETURN 
  40. 6620 T = T +1: NEXT J
  41. 6650 CV = VS: VTAB VS: HTAB HT -3: GOTO 6400
  42. 6690  IF CV >(VS +MN(M) -1)  THEN CV = VS
  43. 6700  IF CV <VS  THEN CV = (VS +MN(M) -1)
  44. 6720  VTAB CV: HTAB HT -3: GOTO 6400
  45. 6760  IF M <8  THEN G(M) = CV
  46. 6770  IF CV = 27  THEN  RETURN 
  47. 6780  GOSUB 6130:T = 0: FOR J = VS TO (VS +MN(M) -1):T = T +1: IF CV = J  THEN CV = T
  48. 6790  NEXT J: RETURN 
  49. 7000  HOME : GOSUB 7440:VT = 7:VB = 16:MN(M) = MN(M) -1:T = 0: FOR J = 1 TO MN(M): VTAB 1: HTAB 1: PRINT MS$(M): VTAB 3: HTAB 1: PRINT PM$(M,0);" ";Y: IF A >1  THEN  GOTO 7090
  50. 7080  HTAB HT: VTAB VT +T: PRINT "("; LEFT$(PM$(M,J),1);")";" ";R$(J);: CALL 64668: GOTO 7100
  51. 7090  HTAB HT: VTAB VT +T: PRINT "(";J;")";" ";R$(J);: CALL 64668
  52. 7100 T = T +1: NEXT J: VTAB 13: HTAB 1: PRINT "_______________________________________"
  53. 7160 MN(M) = MN(M) +2:PM$(M,MN(M) -1) = "DELETE THIS DATA":PM$(M,MN(M)) = "ACCEPT CHANGES":T = 0: FOR J = 1 TO MN(M): IF A >1  THEN  GOTO 7210
  54. 7200  HTAB HB: VTAB VB +T: PRINT "("; LEFT$(PM$(M,J),1);")";" ";PM$(M,J): GOTO 7220
  55. 7210  HTAB HB: VTAB VB +T: PRINT "(";J;")";" ";PM$(M,J)
  56. 7220 T = T +1: NEXT J
  57. 7240 VS = VB:TP = HT:HT = HB: GOSUB 6320:HT = TP:MN(M) = MN(M) -2: IF CV = MN(M) +1  THEN  GOSUB 7290: HOME : GOSUB 7470:MN(M) = MN(M) +1: GOSUB 7500: GOTO 900
  58. 7270  IF CV = MN(M) +2  THEN  TEXT : HOME : GOSUB 7470:MN(M) = MN(M) +1: GOSUB 7500: RETURN 
  59. 7280  GOSUB 7290: GOTO 7300
  60. 7290 X = 0:Y2 = 14:DX = 39:DY = 10: & X,Y2,DX,DY: RETURN 
  61. 7300  IF CV = 27  THEN  TEXT : HOME :MN(M) = MN(M) +1: GOSUB 7500: RETURN 
  62. 7305  GOSUB 7360: GOTO 7160
  63. 7360  IF CV >2  THEN  GOTO 7390
  64. 7370  HOME : PRINT : PRINT "ENTER ";PM$(M,CV): PRINT : GOSUB 600: IF X$ =  CHR$(27)  THEN  GOTO 7420
  65. 7380 R$(CV) = X$:R$(CV +MN(M)) = SX$: GOTO 7420
  66. 7390  HOME : PRINT : PRINT "ENTER ";PM$(M,CV): PRINT : GOSUB 600: IF X$ =  CHR$(27)  THEN  GOTO 7420
  67. 7400 R$(CV) = X$
  68. 7420  VTAB (VT +CV -1): HTAB HT: PRINT "("; LEFT$(PM$(M,CV),1);")";" ";R$(CV);: CALL 64668: HOME : RETURN 
  69. 7440 R$(1) = B$(Y):R$(2) = A$(Y):R$(3) = C$(Y):R$(4) = CC$(Y):R$(5) = E$(Y):R$(6) = SB$(Y):R$(7) = SA$(Y)
  70. 7450  IF  LEN(R$(5)) <17  THEN  FOR Q2 =  LEN(R$(5)) +1 TO 17:R$(5) = R$(5) +" ": NEXT Q2
  71. 7455  RETURN 
  72. 7470 B$(Y) = R$(1):A$(Y) = R$(2):C$(Y) = R$(3):CC$(Y) = R$(4):E$(Y) = R$(5):SB$(Y) = R$(6):SA$(Y) = R$(7): RETURN 
  73. 7500 PM$(M,MN(M)) = "TELEPHONE NUMBER": RETURN 
  74. 16000  IF NP <1  THEN  HOME : VTAB 10: HTAB 10: PRINT "NO DATA IN MEMORY ": HTAB 10: PRINT "PRESS A KEY ";: GET Z$: GOTO 32000
  75. 16010 A = 1:M = 2:HT = 10:VS = 0: GOSUB 6000: ON CV GOTO 17000,17020,33000: IF CV = 27  THEN 32000
  76. 16090  GOTO 16000
  77. 17000  GOSUB 17080: GOTO 16000
  78. 17020 TF = 0: GOSUB 18000
  79. 17040  IF TF = 0  THEN  GOTO 16000
  80. 17060  GOTO 32000
  81. 17080  HOME : VTAB 10: HTAB 12: PRINT " ESC TO GO BACK ": PRINT : HTAB 12: PRINT "RETURN TO CONTINUE": PRINT : PRINT : PRINT : PRINT : HTAB 4: PRINT "(ESC ALSO STOPS PRINT EXECUTION)  ";: GET Z$
  82. 17140  IF M = 4  AND Z$ =  CHR$(27)  THEN Y = F6: POP : GOSUB 23140: HOME : GOSUB 700: GOTO 23000
  83. 17160  IF Z$ =  CHR$(27)  THEN  POP : GOTO 16000
  84. 17180  IF Z$ =  CHR$(13)  THEN  GOTO 17220
  85. 17200  GOTO 17080
  86. 17220  PRINT  CHR$(4);"PR#1": PRINT : PRINT : PRINT : PRINT : IF NP <10  THEN  GOTO 17560
  87. 17260  FOR J = 1 TO NP: IF  PEEK(49152) = 155  THEN  POKE 49168,0: GOTO 17680
  88. 17280  PRINT : PRINT :T1 =  LEN(A$(J)):T2 = 36 -T1: IF T2 > LEN(B$(J))  THEN T2 =  LEN(B$(J))
  89. 17320 T1 =  LEN(A$(J +7)):T3 = 36 -T1: IF T3 > LEN(B$(J +7))  THEN T3 =  LEN(B$(J +7))
  90. 17340  IF T2 = 0  THEN T2 = 1
  91. 17360  IF T3 = 0  THEN T3 = 1
  92. 17380  PRINT  LEFT$(B$(J),T2);" ";A$(J);: PRINT  TAB( 41); LEFT$(B$(J +7),T3);" ";A$(J +7): PRINT C$(J); TAB( 41);C$(J +7): PRINT CC$(J); TAB( 41);CC$(J +7): PRINT 
  93. 17445  PRINT  LEFT$(E$(J),12);: IF  MID$ (E$(J),13,5) = "     "  OR  MID$ (E$(J),13,5) = ""  THEN  GOTO 17455
  94. 17450  PRINT "  EXT.NO. "; MID$ (E$(J),13,5);
  95. 17455  PRINT  TAB( 41); LEFT$(E$(J +7),12);: IF  MID$ (E$(J +7),13,5) = "     "  OR  MID$ (E$(J +7),13,5) = ""  THEN  PRINT : GOTO 17465
  96. 17460  PRINT "  EXT.NO. "; MID$ (E$(J +7),13,5)
  97. 17465  PRINT  MID$ (E$(J),18,12);: IF  MID$ (E$(J),30,5) = "     "  OR  MID$ (E$(J),30,5) = ""  THEN  GOTO 17475
  98. 17470  PRINT "  EXT.NO. "; MID$ (E$(J),30,5);
  99. 17475  PRINT  TAB( 41); MID$ (E$(J +7),18,12);: IF  MID$ (E$(J +7),30,5) = "     "  OR  MID$ (E$(J +7),30,5) = ""  THEN  PRINT : GOTO 17520
  100. 17480  PRINT "  EXT.NO. "; MID$ (E$(J +7),30,5)
  101. 17520  IF (J/7) =  INT(J/7)  THEN J = J +7: PRINT : PRINT : PRINT : PRINT : PRINT : PRINT 
  102. 17540  NEXT J: GOTO 17680
  103. 17560  FOR J = 1 TO NP: IF  PEEK(49152) = 155  THEN  POKE 49168,0: GOTO 17680
  104. 17580 T1 =  LEN(A$(J)):T2 = 36 -T1: IF T2 > LEN(B$(J))  THEN T2 =  LEN(B$(J))
  105. 17600  IF T2 = 0  THEN T2 = 1
  106. 17620  PRINT : PRINT : PRINT  LEFT$(B$(J),T2);" ";A$(J): PRINT C$(J): PRINT CC$(J): PRINT : PRINT  LEFT$(E$(J),12);: IF  MID$ (E$(J),13,5) = "     "  OR  MID$ (E$(J),13,5) = ""  THEN  PRINT : GOTO 17655
  107. 17650  PRINT "  EXT.NO. "; MID$ (E$(J),13,5)
  108. 17655  PRINT  MID$ (E$(J),18,12);: IF  MID$ (E$(J),30,5) = "     "  OR  MID$ (E$(J),30,5) = ""  THEN  PRINT : GOTO 17660
  109. 17657  PRINT "  EXT.NO. "; MID$ (E$(J),30,5)
  110. 17660  NEXT J
  111. 17680  PRINT  CHR$(4);"PR#0": PRINT  CHR$(17): PRINT  CHR$(24): RETURN 
  112. 18000  IF NP <1  THEN  HOME : VTAB 10: HTAB 10: PRINT "NO DATA IN MEMORY  ";: FOR J = 1 TO 1200: NEXT : RETURN 
  113. 18010  HOME : PRINT : PRINT : GOSUB 18500: IF B$(0) < >""  THEN  GOTO 18182
  114. 18015  VTAB 3: HTAB 1: PRINT "PLEASE ENTER THE RETURN ADDRESS": VTAB 1: HTAB 1: PRINT "ESC TO STOP":Y = 0:VT = 7:VB = 16:M = 1:HT = 5:HB = 10: GOSUB 7440
  115. 18030  VTAB 13: HTAB 1: PRINT "_______________________________________": GOSUB 7290
  116. 18060 T = 0: FOR CV = 1 TO MN(M) -1: GOSUB 7360
  117. 18070  IF X$ =  CHR$(27)  THEN  TEXT : HOME : GOSUB 18600: RETURN 
  118. 18080  NEXT CV: GOSUB 7470
  119. 18140  HOME : VTAB 23: HTAB 2: PRINT "DO YOU WISH TO CHANGE ANYTHING ?   ";: GET Z$: IF Z$ < >"Y"  AND Z$ < >"y"  THEN  TEXT : GOTO 19000
  120. 18160  TEXT : HOME : GOSUB 7000
  121. 18182 T1 =  LEN(A$(0)):T2 = 36 -T1: IF T2 > LEN(B$(0))  THEN T2 =  LEN(B$(0))
  122. 18183  IF T2 = 0  THEN T2 = 1
  123. 18184  HOME : VTAB 8: HTAB 2: PRINT  LEFT$(B$(0),T2);" ";A$(0): HTAB 2: PRINT C$(0): HTAB 2: PRINT CC$(0): VTAB 1: HTAB 1: PRINT "ESC TO STOP"
  124. 18200  VTAB 14: PRINT " USE ABOVE AS THE RETURN ADDRESS ? ";: GET Z$: IF Z$ =  CHR$(27)  THEN  GOSUB 18600: RETURN 
  125. 18210  IF Z$ < >"Y"  AND Z$ < >"y"  THEN  HOME : PRINT : GOTO 18015
  126. 18220  GOTO 19000
  127. 18500 A1$ = A$(0):B1$ = B$(0):C1$ = C$(0):C2$ = CC$(0): RETURN 
  128. 18600 A$(0) = A1$:B$(0) = B1$:C$(0) = C1$:CC$(0) = C2$: RETURN 
  129. 19000 W = 8:L = 4:CH = 10
  130. 19010  FOR JP = 1 TO NP
  131. 19020  HOME 
  132. 19025 T1 =  LEN(A$(0)):T2 = 30 -T1: IF T2 > LEN(B$(0))  THEN T2 =  LEN(B$(0))
  133. 19026  IF T2 = 0  THEN T2 = 1
  134. 19030  VTAB 3: PRINT  LEFT$(B$(0),T2);" ";A$(0): PRINT C$(0): PRINT CC$(0): VTAB 1: HTAB 34: PRINT " __ ": VTAB 2: HTAB 34: PRINT "|  |": VTAB 3: HTAB 34: PRINT "|22|": VTAB 4: HTAB 34: PRINT "|__|": VTAB 10:UL =  LEN(B$(JP)) + LEN(A$(JP)) +1
  135. 19092  IF UL >36  THEN UL = 37
  136. 19093 T1 =  LEN(A$(JP)):T2 = 36 -T1: IF T2 > LEN(B$(JP))  THEN T2 =  LEN(B$(JP))
  137. 19100  IF  LEN(C$(JP)) >UL  THEN UL =  LEN(C$(JP))
  138. 19110 UL = 40 -UL: IF UL >15  THEN UL = 15
  139. 19115  IF T2 = 0  THEN T2 = 1
  140. 19120  HTAB (UL): PRINT  LEFT$(B$(JP),T2);" ";A$(JP): HTAB (UL): PRINT C$(JP): HTAB (UL): PRINT CC$(JP): PRINT : PRINT : PRINT "ENVELOPE SIZE : ";W;" x ";L;" INCHES": PRINT : PRINT "PRINTER PITCH = ";CH;" CHARACTERS PER INCH": PRINT 
  141. 19160 A = 1:M = 7:VS = 19:HT = 10: GOSUB 6200
  142. 19190  IF CV = 1  THEN  NEXT JP: GOTO 19010
  143. 19195  IF CV = 2  THEN JP = JP -1: IF JP = 0  THEN JP = NP
  144. 19200  IF CV = 27  THEN  GOSUB 18600: RETURN 
  145. 19210  IF CV = 3  THEN  GOTO 21000
  146. 19230  IF CV < >4  THEN 19020
  147. 20000  HOME : VTAB 10: HTAB 9: PRINT "   ENVELOPE SETTINGS ": VTAB 1: HTAB 1: PRINT "ESC TO QUIT": VTAB 12: HTAB 10: PRINT "  RANGE : 4 - 8 (INCHES) ": VTAB 14: HTAB 10: PRINT "  ENTER THE WIDTH   "
  148. 20015  VTAB 15: HTAB 10: PRINT "  (LEFT - RIGHT )    : ";: GET Z$: CALL 64668: IF Z$ =  CHR$(27)  THEN  GOTO 19010
  149. 20018 W =  VAL(Z$): IF W >8.3  THEN W = 8: GOTO 20000
  150. 20030  IF W <4  THEN W = 8: GOTO 20000
  151. 20040  VTAB 15: HTAB 32: PRINT Z$;: CALL 64668: VTAB 12: HTAB 9: PRINT "   RANGE : 3 -UP (INCHES)  ": VTAB 14: HTAB 9: PRINT "   ENTER THE LENGTH     ": VTAB 15: HTAB 9: PRINT "   (TOP - BOTTOM )    : ";: GET Z$: CALL 64668
  152. 20055  IF Z$ =  CHR$(27)  THEN  GOTO 19010
  153. 20057 L =  VAL(Z$): IF L <3  THEN L = 4: GOTO 20040
  154. 20070  VTAB 15: HTAB 32: PRINT Z$;: CALL 64668: VTAB 12: HTAB 12: PRINT "ENTER CHARACTERS/IN. OF": VTAB 13: HTAB 12: PRINT "THE PRINTER YOU SHALL USE.": VTAB 14: PRINT "";: CALL 64668: VTAB 15: HTAB 12: PRINT "10 ,  12 ,  OR  15   ";: GET Z$
  155. 20102  IF Z$ < > CHR$(13)  THEN  PRINT Z$;
  156. 20104  GET Z2$: IF Z2$ < > CHR$(13)  THEN  PRINT Z2$;: CALL 64668
  157. 20105  IF Z$ =  CHR$(27)  THEN  GOTO 19010
  158. 20106  IF Z2$ =  CHR$(27)  THEN  GOTO 19010
  159. 20107 CH = ( VAL(Z$) *10) + VAL(Z2$)
  160. 20110  VTAB 15: HTAB 32: PRINT "";: CALL 64668
  161. 20120  IF CH < = 0  THEN  GOTO 20070
  162. 20130  IF CH = 10  OR CH = 12  OR CH = 15  THEN  GOTO 20150
  163. 20140  GOTO 20070
  164. 20150  VTAB 15: HTAB 32: PRINT CH;: CALL 64668:W =  INT(W *10)/10:L =  INT(L *10)/10: GOTO 19010
  165. 21000  HOME : VTAB 10: PRINT "PLEASE POSITION YOUR ENVELOPE TO THE TOP LEFT-HAND CORNER": PRINT : PRINT "PRESS A KEY TO PRINT OR ESC TO QUIT  ";: GET Z$: PRINT : IF Z$ =  CHR$(27)  THEN  GOTO 19000
  166. 21020  PRINT  CHR$(4);"PR#1": PRINT  CHR$(27); CHR$(48): PRINT B$(0);" ";A$(0): PRINT C$(0): PRINT CC$(0):Z = (W -3.0 *((18 +W)/18)) *CH:LL = (L *6 -13) *4.0/L:LL =  INT(LL): FOR K = 1 TO LL: PRINT : NEXT K:Z =  INT(Z)
  167. 21090  PRINT  TAB( Z);B$(JP);" ";A$(JP): PRINT  TAB( Z);C$(JP): PRINT  TAB( Z);CC$(JP): PRINT  CHR$(4);"PR#0": NEXT JP:TF = 1: RETURN 
  168. 22000  HOME 
  169. 22010  PRINT  CHR$(4);"CHAIN ADD.ENTER,@22000"
  170. 23000  HOME 
  171. 23010  PRINT  CHR$(4);"CHAIN ADD.ENTER,@23000"
  172. 23080  GOSUB 17080: GOSUB 23140: GOTO 22000
  173. 23110  GOSUB 18000: GOSUB 23140: IF Z$ =  CHR$(27)  THEN  GOTO 23115
  174. 23112  GOTO 23130
  175. 23115  HOME 
  176. 23120  PRINT  CHR$(4);"CHAIN ADD.ENTER,@23115"
  177. 23130  HOME 
  178. 23135  PRINT  CHR$(4);"CHAIN ADD.ENTER,@23116"
  179. 23140 NP = SNP:A$(1) = T1$:B$(1) = T2$:C$(1) = T3$:CC$(1) = T4$:E$(1) = T5$: RETURN 
  180. 32000  HOME 
  181. 32010  PRINT  CHR$(4);"CHAIN ADD.ENTER,@32000"
  182. 33000  HOME 
  183. 33010  PRINT  CHR$(4);"CHAIN ADD.ENTER,@33000"
  184. 40000  PRINT D$;"SAVE /RAM/ADD.PRT"
  185. 40100  PRINT D$;"CHAIN ADD.FILE,@40000"